"
I am a RBBrowserEnvironment for a set of selectors. 
Usually I am constructed as a result of a query on another environment:
env referencesTo:#aselector -> a RBSelectorEnvironments.
"
Class {
	#name : 'RBSelectorEnvironment',
	#superclass : 'RBBrowserEnvironmentWrapper',
	#instVars : [
		'classSelectors',
		'metaClassSelectors'
	],
	#category : 'Refactoring-Environment',
	#package : 'Refactoring-Environment'
}

{ #category : 'accessing - defaults' }
RBSelectorEnvironment class >> defaultName [

	^ 'Selectors'
]

{ #category : 'instance creation' }
RBSelectorEnvironment class >> implementorsMatching: aString [
	^ self
		implementorsMatching: aString
		in: self default
]

{ #category : 'instance creation' }
RBSelectorEnvironment class >> implementorsMatching: aString in: anEnvironment [
	| classDict metaDict |
	classDict := IdentityDictionary new.
	metaDict := IdentityDictionary new.
	anEnvironment classesDo: [ :class |
		| selectors |
		selectors := IdentitySet new.
		anEnvironment selectorsForClass: class
			do: [ :each | (aString match: each) ifTrue: [ selectors add: each ] ].
		selectors isEmpty ifFalse: [
			class isMeta
				ifTrue: [ metaDict at: class soleInstance name put: selectors ]
				ifFalse: [ classDict at: class name put: selectors ] ] ].
	^ (self onEnvironment: anEnvironment)
		classSelectors: classDict metaClassSelectors: metaDict;
		label: 'Implementors of ' , aString;
		yourself
]

{ #category : 'instance creation' }
RBSelectorEnvironment class >> implementorsOf: aSelector [
	^ self
		implementorsOf: aSelector
		in: self default
]

{ #category : 'instance creation' }
RBSelectorEnvironment class >> implementorsOf: aSelector in: anEnvironment [
	| classDict metaDict selectors |
	classDict := IdentityDictionary new.
	metaDict := IdentityDictionary new.
	selectors := IdentitySet with: aSelector.
	anEnvironment classesDo: [ :class |
		((class includesLocalSelector: aSelector) and: [ anEnvironment includesSelector: aSelector in: class ])
			ifTrue: [
				class isMeta
					ifTrue: [ metaDict at: class soleInstance name put: selectors copy ]
					ifFalse: [ classDict at: class name put: selectors copy ] ] ].
	^ (self onEnvironment: anEnvironment)
		classSelectors: classDict metaClassSelectors: metaDict;
		label: 'Implementors of ' , aSelector;
		yourself
]

{ #category : 'instance creation' }
RBSelectorEnvironment class >> matches: aString [
	^ self
		matches: aString
		in: self default
]

{ #category : 'instance creation' }
RBSelectorEnvironment class >> matches: aString in: anEnvironment [
	| newEnvironment |
	newEnvironment := (self onEnvironment: anEnvironment)
		label: 'Matching: ' , aString;
		searchStrings: (Array with: aString);
		yourself.
	anEnvironment classesAndSelectorsDo: [ :class :selector |
		| method |
		method := class compiledMethodAt: selector.
		method withAllNestedLiteralsDo: [ :literal |
			literal isString ifTrue: [
				(aString match: literal)
					ifTrue: [ newEnvironment addClass: class selector: selector ] ] ] ].
	^ newEnvironment
]

{ #category : 'instance creation' }
RBSelectorEnvironment class >> onMethods: selectorCollection forClass: aClass [
	^ self
		onMethods: selectorCollection
		forClass: aClass
		in: self default
]

{ #category : 'instance creation' }
RBSelectorEnvironment class >> onMethods: selectorCollection forClass: aClass in: anEnvironment [
	| environemnt |
	environemnt := self onEnvironment: anEnvironment.
	selectorCollection do: [ :each | environemnt addClass: aClass selector: each ].
	^ environemnt
]

{ #category : 'instance creation' }
RBSelectorEnvironment class >> referencesTo: aLiteral [
	^ self
		referencesTo: aLiteral
		in: self default
]

{ #category : 'instance creation' }
RBSelectorEnvironment class >> referencesTo: aLiteral in: anEnvironment [
	| classDict literalPrintString |
	literalPrintString := aLiteral isVariableBinding
		ifTrue: [ aLiteral key asString ]
		ifFalse: [
			aLiteral isString
				ifTrue: [ aLiteral ]
				ifFalse: [ aLiteral printString ] ].
	classDict := IdentityDictionary new.
	anEnvironment classesDo: [ :class |
		| selectors |
		selectors := (class thoroughWhichSelectorsReferTo: aLiteral)
			select: [ :selector | anEnvironment includesSelector: selector in: class ].
		selectors isEmpty
			ifFalse: [ classDict at: class put: selectors asIdentitySet ] ].
	^ (self onEnvironment: anEnvironment)
		on: classDict;
		label: 'References to: ' , literalPrintString;
		searchStrings: (Array with: literalPrintString);
		yourself
]

{ #category : 'comparing' }
RBSelectorEnvironment >> = anObject [
	"Answer whether the receiver and anObject represent the same object."

	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	^ environment = anObject environment and: [
			  classSelectors = anObject classSelectors and: [
				  metaClassSelectors = anObject metaClassSelectors ] ]
]

{ #category : 'adding' }
RBSelectorEnvironment >> addClass: aClass [
	aClass isMeta
		ifTrue: [ metaClassSelectors at: aClass soleInstance name put: aClass selectors asIdentitySet ]
		ifFalse: [ classSelectors at: aClass name put: aClass selectors asIdentitySet ]
]

{ #category : 'adding' }
RBSelectorEnvironment >> addClass: aClass selector: aSymbol [
	(aClass isMeta
		ifTrue: [ metaClassSelectors at: aClass soleInstance name ifAbsentPut: [ IdentitySet new ] ]
		ifFalse: [ classSelectors at: aClass name ifAbsentPut: [ IdentitySet new ] ])
			add: aSymbol
]

{ #category : 'adding' }
RBSelectorEnvironment >> addMethod: aMethod [
	"this is a method to improve addition of methods, as class and selector data can be retrieved from a single compiled method"

	self addClass: aMethod methodClass selector: aMethod selector
]

{ #category : 'accessing' }
RBSelectorEnvironment >> asSelectorEnvironment [
	^ self
]

{ #category : 'accessing - classes' }
RBSelectorEnvironment >> classNames [
	^ IdentitySet new
		addAll: classSelectors keys;
		addAll: metaClassSelectors keys;
		yourself
]

{ #category : 'accessing' }
RBSelectorEnvironment >> classSelectors [

	^ classSelectors
]

{ #category : 'initialization' }
RBSelectorEnvironment >> classSelectors: classSelectorDictionary metaClassSelectors: metaClassSelectorDictionary [
	classSelectors := classSelectorDictionary.
	metaClassSelectors := metaClassSelectorDictionary
]

{ #category : 'initialization' }
RBSelectorEnvironment >> classes: classArray metaClasses: metaArray [
	"Used to recreate an environment from its storeString"

	classSelectors := IdentityDictionary new.
	metaClassSelectors := IdentityDictionary new.
	classArray
		do: [ :each | classSelectors at: each first put: each last asIdentitySet ].
	metaArray
		do: [ :each | metaClassSelectors at: each first put: each last asIdentitySet ]
]

{ #category : 'accessing - classes' }
RBSelectorEnvironment >> classesDo: aBlock [
	classSelectors keysDo: [ :each |
		| class |
		class := self systemDictionary at: each ifAbsent: [ nil ].
		(class isNotNil and: [ environment includesClass: class ])
			ifTrue: [ aBlock value: class ] ].
	metaClassSelectors keysDo: [ :each |
		| class |
		class := self systemDictionary at: each ifAbsent: [ nil ].
		(class isNotNil and: [ environment includesClass: class class ])
			ifTrue: [ aBlock value: class class ] ]
]

{ #category : 'private' }
RBSelectorEnvironment >> defaultLabel [
	^'some methods'
]

{ #category : 'comparing' }
RBSelectorEnvironment >> hash [
	"Answer an integer value that is related to the identity of the receiver."

	^ classSelectors hash bitXor: metaClassSelectors hash
]

{ #category : 'testing' }
RBSelectorEnvironment >> includesClass: aClass [
	^(self privateSelectorsForClass: aClass) isNotEmpty
		and: [super includesClass: aClass]
]

{ #category : 'testing' }
RBSelectorEnvironment >> includesProtocol: aProtocol in: aClass [

	^ (super includesProtocol: aProtocol in: aClass) and: [
		  (environment selectorsFor: aProtocol in: aClass) anySatisfy: [ :aSelector | self privateIncludesSelector: aSelector inClass: aClass ] ]
]

{ #category : 'testing' }
RBSelectorEnvironment >> includesSelector: aSelector in: aClass [
	^(environment includesSelector: aSelector in: aClass)
		and: [self privateIncludesSelector: aSelector inClass: aClass]
]

{ #category : 'initialization' }
RBSelectorEnvironment >> initialize [
	super initialize.
	classSelectors := IdentityDictionary new.
	metaClassSelectors := IdentityDictionary new
]

{ #category : 'testing' }
RBSelectorEnvironment >> isEmpty [
	^classSelectors isEmpty and: [metaClassSelectors isEmpty]
]

{ #category : 'testing' }
RBSelectorEnvironment >> isSelectorEnvironment [
	^ true
]

{ #category : 'accessing' }
RBSelectorEnvironment >> metaClassSelectors [

	^ metaClassSelectors
]

{ #category : 'initialization' }
RBSelectorEnvironment >> on: aDictionary [
	aDictionary keysAndValuesDo: [ :class :selectors |
		class isMeta
			ifTrue: [ metaClassSelectors at: class soleInstance name put: selectors asIdentitySet ]
			ifFalse: [ classSelectors at: class name put: selectors asIdentitySet ] ]
]

{ #category : 'copying' }
RBSelectorEnvironment >> postCopy [
	| newDict |
	super postCopy.
	newDict := classSelectors copy.
	newDict keysAndValuesDo: [:key :value | newDict at: key put: value copy].
	classSelectors := newDict.
	newDict := metaClassSelectors copy.
	newDict keysAndValuesDo: [:key :value | newDict at: key put: value copy].
	metaClassSelectors := newDict
]

{ #category : 'private' }
RBSelectorEnvironment >> privateIncludesSelector: aSelector inClass: aClass [
	^(self privateSelectorsForClass: aClass) includes: aSelector
]

{ #category : 'private' }
RBSelectorEnvironment >> privateSelectorsForClass: aClass [
	^aClass isMeta
		ifTrue: [metaClassSelectors at: aClass soleInstance name ifAbsent: [#()]]
		ifFalse: [classSelectors at: aClass name ifAbsent: [#()]]
]

{ #category : 'removing' }
RBSelectorEnvironment >> removeClass: aClass [
	aClass isMeta
		ifTrue: [metaClassSelectors removeKey: aClass soleInstance name ifAbsent: []]
		ifFalse: [classSelectors removeKey: aClass name ifAbsent: []]
]

{ #category : 'removing' }
RBSelectorEnvironment >> removeClass: aClass selector: aSelector [

	| class |
	class := aClass isMeta
		         ifTrue: [
			         metaClassSelectors
				         at: aClass soleInstance name
				         ifAbsent: [ ^ self ] ]
		         ifFalse: [
		         classSelectors at: aClass name ifAbsent: [ ^ self ] ].
	class remove: aSelector ifAbsent: [  ].
	class ifEmpty: [ self removeClass: aClass ]
]

{ #category : 'accessing' }
RBSelectorEnvironment >> selectorsForClass: aClass do: aBlock [

	^ (self privateSelectorsForClass: aClass) copy do: [ :each |
		  (aClass includesSelector: each) ifTrue: [ aBlock value: each ] ]
]

{ #category : 'storing' }
RBSelectorEnvironment >> storeOn: aStream [
	| classBlock |
	aStream
		nextPutAll: '((';
		nextPutAll: self class name;
		nextPutAll: ' onEnvironment: '.
	environment storeOn: aStream.
	aStream
		nextPut: $);
		nextPutAll: ' classes: #('.
	classBlock :=
			[:key :value |
			aStream
				nextPutAll: '#(';
				nextPutAll: key;
				nextPutAll: ' #('.
			value do:
					[:each |
					aStream
						nextPutAll: each;
						nextPut: $ ].
			aStream
				nextPutAll: '))';
				cr].
	classSelectors keysAndValuesDo: classBlock.
	aStream nextPutAll: ') metaClasses: #('.
	metaClassSelectors keysAndValuesDo: classBlock.
	aStream nextPutAll: '))'
]
